Languguage OS 2/Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO/a_utils/perl/prlrf435.lha/parr

Text File | 1992-02-18 | 4KB | 193 lines

#!/usr/bin/perl

# @(#)@ parr 4.2.3

# rearrange conforming PS code to print the pages in an arbitrary
# order.  The -o option takes a list of ranges, like this:
#    1-5    1-10,11-20    11-,1-10
# usage: parr [-a4] [-o list] [file]
#
# [e-mail], 89/10/23
# modified by [e-mail], 91/078/15

$order='';
$signFlag='';
$signCount=0;
$DEBUG=0;
$TMPDIR='/usr/tmp';

while ($_ = $ARGV[0],/^-/) {
    shift;
    last if /^-\-$/;
    /^-o(rder)?$/ && ($order = shift,next);
    /^-a4$/ && ($a4flag++,next);
    die "usage: parr [-a4] [-order list] [file]\n";
}

$file = "$TMPDIR/p$$.header";
@files = ($file);
$sheet=0;
open(FILE,">$file") || die "$file: $!\n";
while (<>) {
    #
    # hack to use NeXT Preview: strip old '%%Pages:' lines
    #
    next if /^%%Pages:/;
    if (/^%%Page:/) {
        $sheet++;
        $pagemap{$sheet} = $1 if /%%Page:\s+(\S+)\s+\S+/;
        close(FILE);
        $file = "$TMPDIR/p$$.$sheet";
        push(@files,$file);
        open(FILE,">$file") || die "$file: $!\n";
    }
    if (/^%%Trailer/) {
        close(FILE);
        $file = "$TMPDIR/p$$.trailer";
        push(@files,$file);
        open(FILE,">$file") || die "$file: $!\n";
    }
    if (/^TeXDict begin @(a4|letter)/) {
        # Insert twoup before switching to TeXDict
        &twoup;
        $twoup++;
        &double_sided;
        print FILE "TeXDict begin @landscape\n";
        next;
    }
    print FILE $_;
}
close(FILE);
die "twoup insertion error\n" unless $twoup == 1;

@order = ();
if ($order) {
    foreach $range (split(/,/,$order)) {
        ($start,$sep,$end) = split(/(-)/,$range);
        $start = 1 unless $start;
        $end = $sheet unless $end;
        if ($sep) {
            push(@order,$start..$end);
        }else{
            push(@order,$start);
        }
    }
}elsif ($signFlag) {
    if (! $signCount) {
        $signCount = $sheet;
        $signCount += (4 - $sheet % 4) if ($sheet % 4);
    }else{
        $signCount *=4;
    }
    for($base=0;$base<$sheet;$base+=$signCount) {
        @tmp = ($signCount/2+$base);
        push(@tmp,$tmp[0]+1,$tmp[0]+2,$tmp[0]-1);
        while ($tmp[3] > $base) {
            push(@order,@tmp);
            @tmp = ($tmp[0]-2,$tmp[1]+2,$tmp[2]+2,$tmp[3]-2);
        }
    }
}else{
    @order = (1..$sheet);
}

@tmp=@order;
@order=();
foreach $page (@tmp) {
    push(@order,$page > $sheet ? "B" : $page);
}

open(FILE,"$TMPDIR/p$$.header");
$_ = <FILE>;
print $_,"%%Pages: (atend)\n";
print while <FILE>;
close(FILE);

$count = 0;
foreach $page (@order) {
    $count++;
    $num = "?";
    $num = $pagemap{$page} if defined $pagemap{$page};
    $num .= "/" . $pagemap{$order[$count]}
        if defined $pagemap{$order[$count]};
    print "%%Page: $num ", ($count+1)/2, "\n" if $count & 1;
    print "%%OldPage: $page\n";
    if ($page eq "B") {
        print "showpage\n";
    }else{
        open(FILE,"$TMPDIR/p$$.$page");
        while (<FILE>) {
            print unless /^%%Page:/;
        }
        close(FILE);
    }
}
open(FILE,"$TMPDIR/p$$.trailer");
print while <FILE>;
close(FILE);
print "%%Pages: ", int(($count+1)/2), " 0\n";

unlink @files unless $DEBUG;
exit(0);

sub twoup {
$factor = 0.707106781187;

# Measurements are in 1/100 inch approx.
if ( $a4flag) {
    $topmargin = -57;
    $leftmargin = 28;
    $othermargin = 445;    # do not change -- relative to $leftmargin
}
else {
    $topmargin = -30;
    $leftmargin = 0;
    $othermargin = 445;    # do not change -- relative to $leftmargin
}
$vsize = -1 - $factor;
print FILE <<EOD;
/isoddpage true def
/orig-showpage /showpage load def
/showpage {
        isoddpage not { orig-showpage } if
        /isoddpage isoddpage not store
    } def

/bop-hook {
    /vsize $vsize def
        isoddpage
    { $factor $factor scale $topmargin $leftmargin translate }
        { 0 $othermargin translate}
    ifelse
    } def

/end-hook{ isoddpage not { orig-showpage } if } def
EOD
}

sub double_sided {

    # From: Tim Huckvale <[e-mail]>
    #
    # You may be interested in the following problem, and fix, that we
    # found when attempting to print the reference card on our Hewlett
    # Packard Laser-Jet IIISi printer.
    #
    # On this printer, refguide.ps prints double-sided with the
    # reverse side of each sheet upside down.  We fixed it with the
    # following patch, applied before printing.

    # From: Johan Vromans <[e-mail]>
    #
    # Okay -- consider this an unsupported feature.

    print FILE <<EOD;
statusdict /setduplexmode known { statusdict begin true setduplexmode end } if
statusdict /settumble known { statusdict begin true settumble end } if
EOD
}

# Local Variables:
# mode:(perl)
# End: